home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / reuse.lha / reuse / src / Errors.mi < prev    next >
Text File  |  1992-08-18  |  9KB  |  274 lines
  1. (* $Id: Errors.mi,v 1.0 1992/08/07 14:41:59 grosch rel $ *)
  2.  
  3. (* $Log: Errors.mi,v $
  4. # Revision 1.0  1992/08/07  14:41:59  grosch
  5. # Initial revision
  6. #
  7.  *)
  8.  
  9. (* Ich, Doktor Josef Grosch, Informatiker, Juli 1992 *)
  10.  
  11. IMPLEMENTATION MODULE Errors;
  12.  
  13. FROM SYSTEM    IMPORT ADDRESS, TSIZE, ADR;
  14. FROM Memory    IMPORT Alloc;
  15. FROM IO        IMPORT tFile, StdError, WriteC, WriteNl, WriteS, WriteI,
  16.                WriteB, WriteR, CloseIO;
  17. FROM Positions    IMPORT tPosition, Compare, WritePosition;
  18. FROM StringMem    IMPORT tStringRef, PutString, GetString;
  19. FROM Strings    IMPORT tString, ArrayToString, StringToArray;
  20. FROM Idents    IMPORT tIdent, WriteIdent, MakeIdent;
  21. FROM Sets    IMPORT tSet, WriteSet, Assign, MakeSet, Size;
  22. FROM Sort    IMPORT Sort;
  23.  
  24. IMPORT System, Strings;
  25.  
  26. CONST MaxError    = 100;
  27.  
  28. TYPE tArray    = ARRAY [0..255] OF CHAR;
  29.  
  30. TYPE tError    = RECORD
  31.                        Position    : tPosition    ;
  32.                        IsErrorCode    : BOOLEAN    ;
  33.                        ErrorNumber    : SHORTCARD    ;
  34.                        ErrorCode    : SHORTCARD    ;
  35.                        ErrorClass    : SHORTCARD    ;
  36.              CASE      InfoClass    : SHORTCARD    OF
  37.              | None    :
  38.              | Integer    : vInteger    : INTEGER    ;
  39.              | Short    : vShort    : INTEGER    ;
  40.              | Long    : vLong        : INTEGER    ;
  41.              | Real    : vReal        : REAL        ;
  42.              | Boolean    : vBoolean    : BOOLEAN    ;
  43.              | Character: vCharacter    : CHAR        ;
  44.              | String    : vString    : tStringRef    ;
  45.              | Array    : vArray    : tStringRef    ;
  46.              | Set    : vSet        : POINTER TO tSet;
  47.              | Ident    : vIdent    : tIdent    ;
  48.              END;
  49.           END;
  50.  
  51. VAR
  52.    ErrorTable    : ARRAY [0..MaxError] OF tError;
  53.    MessageCount    : INTEGER;
  54.    IsStore    : BOOLEAN;
  55.    HandleMessage: PROCEDURE (BOOLEAN, CARDINAL, CARDINAL, tPosition, CARDINAL, ADDRESS);
  56.    Out        : tFile;
  57.  
  58. PROCEDURE ErrorMessage    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition);
  59.    BEGIN
  60.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, None, NIL);
  61.    END ErrorMessage;
  62.  
  63. PROCEDURE ErrorMessageI    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition;
  64.              InfoClass: CARDINAL; Info: ADDRESS);
  65.    BEGIN
  66.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, InfoClass, Info);
  67.    END ErrorMessageI;
  68.  
  69. PROCEDURE Message  (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition);
  70.    VAR String    : tString;
  71.    BEGIN
  72.       ArrayToString (ErrorText, String);
  73.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, None, NIL);
  74.    END Message;
  75.  
  76. PROCEDURE MessageI (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition;
  77.              InfoClass: CARDINAL; Info: ADDRESS);
  78.    VAR String    : tString;
  79.    BEGIN
  80.       ArrayToString (ErrorText, String);
  81.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, InfoClass, Info);
  82.    END MessageI;
  83.  
  84. PROCEDURE WriteHead (Position: tPosition; ErrorClass: CARDINAL);
  85.    BEGIN
  86.       WritePosition (Out, Position);
  87.       WriteS    (Out, ": ");
  88.       CASE ErrorClass OF
  89.       |  Fatal        : WriteS (Out, "Fatal       ");
  90.       |  Restriction    : WriteS (Out, "Restriction ");
  91.       |  Error        : WriteS (Out, "Error       ");
  92.       |  Warning    : WriteS (Out, "Warning     ");
  93.       |  Repair        : WriteS (Out, "Repair      ");
  94.       |  Note        : WriteS (Out, "Note        ");
  95.       |  Information    : WriteS (Out, "Information ");
  96.       ELSE WriteS (Out, "Error class: "); WriteI (Out, ErrorClass, 0);
  97.       END;
  98.    END WriteHead;
  99.  
  100. PROCEDURE WriteCode (ErrorCode: CARDINAL);
  101.    BEGIN
  102.       CASE ErrorCode OF
  103.       |  NoText        :
  104.       |  SyntaxError    : WriteS (Out, "syntax error"        );
  105.       |  ExpectedTokens    : WriteS (Out, "expected tokens"    );
  106.       |  RestartPoint    : WriteS (Out, "restart point"        );
  107.       |  TokenInserted    : WriteS (Out, "token inserted "    );
  108.       |  WrongParseTable: WriteS (Out, "parse table mismatch"    );
  109.       |  OpenParseTable    : WriteS (Out, "cannot open parse table");
  110.       |  ReadParseTable    : WriteS (Out, "cannot read parse table");
  111.       |  TooManyErrors    : WriteS (Out, "too many errors"    );
  112.       ELSE WriteS (Out, " error code: "); WriteI (Out, ErrorCode, 0);
  113.       END;
  114.    END WriteCode;
  115.  
  116. PROCEDURE WriteInfo (InfoClass: CARDINAL; Info: ADDRESS);
  117.    VAR
  118.       PtrToInteger    : POINTER TO INTEGER;
  119.       PtrToShort    : POINTER TO SHORTCARD;
  120.       PtrToLong        : POINTER TO LONGINT;
  121.       PtrToReal        : POINTER TO REAL;
  122.       PtrToBoolean    : POINTER TO BOOLEAN;
  123.       PtrToCharacter    : POINTER TO CHAR;
  124.       PtrToString    : POINTER TO tString;
  125.       PtrToArray    : POINTER TO tArray;
  126.       PtrToIdent    : POINTER TO tIdent;
  127.    BEGIN
  128.       IF InfoClass = None THEN RETURN; END;
  129.       WriteS (Out, ": ");
  130.       CASE InfoClass OF
  131.       | Integer    : PtrToInteger    := Info; WriteI (Out, PtrToInteger^, 0);
  132.       | Short      : PtrToShort    := Info; WriteI (Out, PtrToShort^, 0);
  133.       | Long       : PtrToLong    := Info; WriteI (Out, PtrToLong^, 0);
  134.       | Real       : PtrToReal    := Info; WriteR (Out, PtrToReal^, 1, 10, 1);
  135.       | Boolean    : PtrToBoolean    := Info; WriteB (Out, PtrToBoolean^);
  136.       | Character:PtrToCharacter:= Info; WriteC (Out, PtrToCharacter^);
  137.       | String    : PtrToString    := Info; Strings.WriteS (Out, PtrToString^);
  138.       | Array    : PtrToArray    := Info; WriteS (Out, PtrToArray^);
  139.       | Ident    : PtrToIdent    := Info; WriteIdent (Out, PtrToIdent^);
  140.       ELSE
  141.       END;
  142.    END WriteInfo;
  143.  
  144. PROCEDURE WriteMessage    (IsErrorCode: BOOLEAN; ErrorCode, ErrorClass: CARDINAL;
  145.              Position: tPosition; InfoClass: CARDINAL; Info: ADDRESS);
  146.    BEGIN
  147.       WriteHead (Position, ErrorClass);
  148.       IF IsErrorCode THEN
  149.      WriteCode (ErrorCode);
  150.       ELSE
  151.      WriteIdent (Out, ErrorCode);
  152.       END;
  153.       WriteInfo (InfoClass, Info);
  154.       WriteNl (Out);
  155.       IF (ErrorClass = Fatal) AND NOT IsStore THEN Exit; END;
  156.    END WriteMessage;
  157.  
  158. PROCEDURE WriteMessages    (File: tFile);
  159.    VAR i    : INTEGER;
  160.    VAR Info    : ADDRESS;
  161.    VAR s    : tString;
  162.    BEGIN
  163.       Sort (1, MessageCount, IsLess, Swap);
  164.       Out := File;
  165.       FOR i := 1 TO MessageCount DO
  166.      WITH ErrorTable [i] DO
  167.         CASE InfoClass OF
  168.         | Integer    : Info := ADR (vInteger    );
  169.         | Short    : Info := ADR (vShort    );
  170.         | Long    : Info := ADR (vLong    );
  171.         | Real    : Info := ADR (vReal    );
  172.         | Boolean    : Info := ADR (vBoolean    );
  173.         | Character    : Info := ADR (vCharacter);
  174.         | String    : GetString (vString, s); Info := ADR (s);
  175.         | Set    : Info :=      vSet     ;
  176.         | Ident    : Info := ADR (vIdent    );
  177.         ELSE
  178.         END;
  179.         WriteMessage (IsErrorCode, ErrorCode, ErrorClass, Position, InfoClass, Info);
  180.      END;
  181.       END;
  182.       Out := StdError;
  183.    END WriteMessages;
  184.  
  185. PROCEDURE StoreMessage    (pIsErrorCode: BOOLEAN; pErrorCode, pErrorClass: CARDINAL;
  186.              pPosition: tPosition; pInfoClass: CARDINAL; pInfo: ADDRESS);
  187.    VAR
  188.       PtrToInteger    : POINTER TO INTEGER    ;
  189.       PtrToShort    : POINTER TO SHORTCARD    ;
  190.       PtrToLong        : POINTER TO LONGINT    ;
  191.       PtrToReal        : POINTER TO REAL    ;
  192.       PtrToBoolean    : POINTER TO BOOLEAN    ;
  193.       PtrToCharacter    : POINTER TO CHAR    ;
  194.       PtrToString    : POINTER TO tString    ;
  195.       PtrToArray    : POINTER TO tArray    ;
  196.       PtrToSet        : POINTER TO tSet    ;
  197.       PtrToIdent    : POINTER TO tIdent    ;
  198.       s            : tString        ;
  199.    BEGIN
  200.       IF MessageCount < MaxError THEN
  201.      INC (MessageCount);
  202.      WITH ErrorTable [MessageCount] DO
  203.         Position    := pPosition    ;
  204.         IsErrorCode    := pIsErrorCode    ;
  205.         ErrorNumber    := MessageCount    ;
  206.         ErrorCode    := pErrorCode    ;
  207.         ErrorClass    := pErrorClass    ;
  208.         InfoClass    := pInfoClass    ;
  209.         CASE InfoClass OF
  210.         | Integer    : PtrToInteger    := pInfo; vInteger    := PtrToInteger    ^;
  211.         | Short    : PtrToShort    := pInfo; vShort    := PtrToShort    ^;
  212.         | Long    : PtrToLong    := pInfo; vLong        := PtrToLong    ^;
  213.         | Real    : PtrToReal    := pInfo; vReal        := PtrToReal    ^;
  214.         | Boolean    : PtrToBoolean    := pInfo; vBoolean    := PtrToBoolean    ^;
  215.         | Character    : PtrToCharacter:= pInfo; vCharacter    := PtrToCharacter^;
  216.         | String    : PtrToString    := pInfo; vString    := PutString (PtrToString^);
  217.         | Array    : PtrToArray    := pInfo; ArrayToString (PtrToArray^, s);
  218.               InfoClass    := String;vArray    := PutString (s);
  219.         | Set    : PtrToSet    := pInfo; vSet        := Alloc (TSIZE (tSet));
  220.                           MakeSet (vSet^, Size (PtrToSet^));
  221.                           Assign  (vSet^, PtrToSet^);
  222.         | Ident    : PtrToIdent    := pInfo; vIdent    := PtrToIdent    ^;
  223.         ELSE
  224.         END;
  225.      END;
  226.       ELSE
  227.      WITH ErrorTable [MessageCount] DO
  228.         IsErrorCode    := TRUE        ;
  229.         ErrorCode    := TooManyErrors;
  230.         ErrorClass    := Restriction    ;
  231.         InfoClass    := None        ;
  232.      END;
  233.       END;
  234.       IF pErrorClass = Fatal THEN WriteMessages (StdError); Exit; END;
  235.    END StoreMessage;
  236.  
  237. PROCEDURE IsLess (i, j: INTEGER): BOOLEAN;
  238.    VAR r: INTEGER;
  239.    BEGIN
  240.       r := Compare (ErrorTable [i].Position, ErrorTable [j].Position);
  241.       IF r = -1 THEN RETURN TRUE ; END;
  242.       IF r = +1 THEN RETURN FALSE; END;
  243.       RETURN ErrorTable [i].ErrorNumber < ErrorTable [j].ErrorNumber;
  244.    END IsLess;
  245.  
  246. PROCEDURE Swap (i, j: INTEGER);
  247.    VAR t: tError;
  248.    BEGIN
  249.       t := ErrorTable [i]; ErrorTable [i] := ErrorTable [j]; ErrorTable [j] := t;
  250.    END Swap;
  251.  
  252. PROCEDURE StoreMessages (Store: BOOLEAN);
  253.    BEGIN
  254.       IF Store THEN
  255.      HandleMessage := StoreMessage;
  256.      MessageCount  := 0;
  257.       ELSE
  258.      HandleMessage := WriteMessage;
  259.       END;
  260.       IsStore := Store;
  261.    END StoreMessages;
  262.  
  263. PROCEDURE yyExit;
  264.    BEGIN
  265.       CloseIO; System.Exit (1);
  266.    END yyExit;
  267.  
  268. BEGIN
  269.    Exit        := yyExit;
  270.    IsStore    := FALSE;
  271.    Out        := StdError;
  272.    HandleMessage:= WriteMessage;
  273. END Errors.
  274.